home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 081-090 / amok82 / env2.0 / env.mod < prev    next >
Text File  |  1993-11-04  |  7KB  |  221 lines
  1. (***************************************************************************
  2.  
  3. :Program.    Env.mod
  4. :Contents.   Shows contents of local and global dos environment variables
  5. :Author.     Hartmut Goebel [hG] & Thomas Wagner [tom]
  6. :Address.    [hG] Aufseßplatz 5, D-8500 Nürnberg 40
  7. :Copyright.  Public Domain
  8. :Language.   Oberon
  9. :Translator. AmigaOberon V2.43
  10. :History.    V1.0, 28 Oct 1991 [hG]
  11. :History.    V1.1, 24 Feb 1992 [hG]  ^Output: contents now always at col 21
  12. :History.    V1.2, 05 Mar 1992 [hG]  +template, LocalVars, Flags
  13. :History.    V1.3, 12 Apr 1992 [hG]  ^flags now always with 4 digits +len
  14.                                      ·changed template +version string
  15. :History.    V2.0, 02 Sep 1992 [tom] +dir, all, showsys
  16.                                      ^using ExAll instead of Examine/ExNext
  17.                                      ^many small changes
  18.                                      -bug: memory loss
  19. :Date.       13 Sep 1992 12:02:47
  20.  
  21. :Remark.     needs AmigaDos 2.0
  22. :Usage.      env dir,lo=locals/S,go=globals/S,flags/S,len/S,all/S,showsys/S
  23.  
  24. ***************************************************************************)
  25.  
  26. MODULE Env;
  27.  
  28. IMPORT
  29.   d  := Dos,
  30.   e  := Exec,
  31.   ol := OberonLib,
  32.   str:= Strings,
  33.   s  := SYSTEM,
  34.   wb := Workbench;
  35.  
  36. CONST
  37.  
  38.   need20 = "I need at least AmigaDos 2.0\n";
  39.   Version = "$VER: env 2.0 (08.09.1992) [hG][tom]";
  40.  
  41.   Template = "DIR,LO=LOCALS/S,GO=GLOBALS/S,FLAGS/S,LEN/S,ALL/S,SHOWSYS/S";
  42.   iffFile = "\e[1mIFF\e[m";
  43.   infoFile = "\e[1mICON\e[m";
  44.  
  45. TYPE
  46.   EnvVarPtr = UNTRACED POINTER TO EnvVar;
  47.   EnvVar = RECORD
  48.     name: ARRAY 30 OF CHAR;
  49.     contents: e.STRING;
  50.   END;
  51.  
  52.   ARGV = STRUCT
  53.     dir: e.STRPTR;
  54.     locals: LONGINT;
  55.     globals: LONGINT;
  56.     flags: LONGINT;
  57.     len: LONGINT;
  58.     all: LONGINT;
  59.     showSys: LONGINT;
  60.   END;
  61.  
  62. VAR
  63.   Env: EnvVar(*Ptr*);
  64.   Var: d.LocalVarPtr;
  65.   Me: d.ProcessPtr;
  66.   Arguments: d.RDArgsPtr;
  67.   Argv: ARGV;
  68.   dir: e.STRING;
  69.   break  : BOOLEAN;
  70.   prgname: ARRAY 30 OF CHAR;
  71.   DirLen: INTEGER;
  72.  
  73. (* The following PROCEDURE is called recursively for each entered directory *)
  74.  
  75. PROCEDURE Examine(dir: ARRAY OF CHAR; file: e.STRPTR);
  76. VAR
  77.   Lock: d.FileLockPtr;
  78.   more : BOOLEAN;
  79.   buffer: ARRAY 128 OF CHAR;
  80.   eac: d.ExAllControlPtr;
  81.   EAData : POINTER TO ARRAY 512 OF e.BYTE;
  82.   ead : d.ExAllDataPtr;
  83.  
  84. BEGIN
  85.   IF ~((d.CheckSignal(LONGSET{d.ctrlC})=LONGSET{}) & ~break) THEN
  86.     (* Oh, user want to stop this nice tool? Then stop it (snif) *)
  87.     break := TRUE;
  88.   ELSE
  89.  
  90.     (* Allocate a buffer for the directory *)
  91.     NEW(EAData);
  92.  
  93.     (* Allocate a ExAllControl-sctructure *)
  94.     eac := d.AllocDosObject(d.exAllControl,NIL);
  95.     IF eac = NIL THEN
  96.       HALT(20) END;
  97.  
  98.     eac.lastKey := 0; (* This MUST be set to zero before starting ExAll *)
  99.  
  100.     (* Join dir and file (here a dir, too) *)
  101.     IF (file # NIL) THEN
  102.       IF ~d.AddPart(dir,file^,LEN(dir)-1) THEN
  103.         HALT(20)
  104.       END;
  105.     END;
  106.     IF DirLen = 0 THEN
  107.       DirLen := SHORT(str.Length(dir));
  108.       IF dir[DirLen] # ":" THEN INC(DirLen); END;
  109.     END;
  110.  
  111.     (* Get a lock on this dir *)
  112.     Lock := d.Lock(dir,d.sharedLock);
  113.     IF Lock = NIL THEN
  114.       HALT(20); END;
  115.     REPEAT
  116.       more := d.ExAll(Lock,EAData^,SIZE(EAData^),d.type,eac);
  117.  
  118.       IF (~more) & (d.IoErr() # d.noMoreEntries) THEN
  119.         (* There are no more entries, but DOS didn't stop with
  120.            d.noMoreEntries --> ERROR *)
  121.         HALT(20) END;
  122.  
  123.       IF eac.entries # 0 THEN
  124.         ead := s.VAL(d.ExAllDataPtr,EAData);
  125.         REPEAT
  126.           IF (ead.type < 0) THEN (* not a  directory *)
  127.             COPY(dir,buffer);
  128.             IF ~d.AddPart(buffer,ead.name^,SIZE(buffer)-1) THEN
  129.               HALT(20) END;
  130.             IF d.GetVar(buffer,Env.contents,
  131.                           SIZE(e.STRING),LONGSET{d.globalOnly}) > 0 THEN
  132.               IF Env.contents = "FORM" THEN Env.contents := iffFile END;
  133.               (* $OvflChk- *)
  134.               IF ORD(Env.contents[0])*256 + ORD(Env.contents[1]) = wb.diskMagic THEN
  135.               (* $OvflChk= *)
  136.                 (* so it must be an ICON *)
  137.                 Env.contents := infoFile; END;
  138.               IF str.Length(buffer)>34 THEN buffer[33] := "»" END;
  139.               d.PrintF("%-30.30s %s\n",s.ADR(buffer[DirLen]),s.ADR(Env.contents));
  140.             END;
  141.           ELSE                   (* directory *)
  142.             COPY(ead.name^,buffer);
  143.             str.Upper(buffer);
  144.             IF (Argv.all # d.DOSFALSE) & (buffer # "SYS")
  145.             OR (Argv.showSys # d.DOSFALSE) & (buffer = "SYS") THEN
  146.               Examine(dir,ead.name);       (* recursively enter dir *)
  147.             ELSE
  148.               d.PrintF("%s/\n",ead.name);  (* only print it's name *)
  149.             END;
  150.           END;
  151.           ead := ead.next;  (* get next entry *)
  152.         UNTIL ead = NIL;
  153.       END;
  154.     UNTIL (~more);
  155.     d.UnLock(Lock);
  156.     d.FreeDosObject(d.exAllControl,eac);
  157. (* $IFNOT GarbageCollector *)
  158.     DISPOSE(EAData);
  159. (* $END *)
  160.   END;
  161. END Examine;
  162.  
  163. BEGIN
  164.   IF ol.wbStarted THEN HALT(20); END; (* WB, what's THAT? :-) *)
  165.   IF d.dos.lib.version < 36 THEN
  166.     IF d.Write(d.Output(),need20,SIZE(need20)) = 0 THEN END;
  167.     HALT(20);
  168.   END;
  169.   Me := s.ADR(Version); (* !!dummy!! *)
  170.   Me := s.VAL(d.ProcessPtr,ol.Me);
  171.   IF ~ d.GetProgramName(prgname,30) THEN prgname := "env" END;
  172.  
  173.   Arguments := d.ReadArgs(Template,Argv,NIL);
  174.   IF Arguments = NIL THEN
  175.     IF d.PrintFault(d.IoErr(),prgname) THEN END;
  176.     HALT(20);
  177.   END;
  178.  
  179.   (* No type and dir specified -> show both *)
  180.   IF (Argv.locals = d.DOSFALSE)
  181.    & (Argv.globals = d.DOSFALSE)
  182.    & (Argv.dir = NIL) THEN
  183.     Argv.globals := d.DOSTRUE;
  184.     Argv.locals := d.DOSTRUE;
  185.   END;
  186.   IF Argv.dir # NIL THEN Argv.globals := d.DOSTRUE END;
  187.  
  188.   (* local vars *)
  189.   IF Argv.locals # d.DOSFALSE THEN
  190.     Var := s.VAL(d.LocalVarPtr,Me.localVars.head);
  191.     WHILE Var.node.succ # NIL DO
  192.        IF Var.node.type = 0 THEN
  193.          IF Argv.len # d.DOSFALSE THEN
  194.            d.PrintF("%3.3ld ",Var.len);
  195.          END;
  196.          IF Argv.flags # d.DOSFALSE THEN
  197.            d.PrintF("%04.4lx ",s.VAL(INTEGER,Var.flags));
  198.          END;
  199.          d.PrintF("%-20.20s %s\n",Var.node.name,Var.value);
  200.          (*IF d.WriteChars(Var.value^,Var.len) = 0 THEN END;
  201.          IF d.PutStr("\n") = 0 THEN END;*)
  202.        END;
  203.        Var := Var.node.succ;
  204.     END;
  205.   END;
  206.  
  207.   IF (Argv.globals # d.DOSFALSE) & (Argv.locals # d.DOSFALSE) THEN
  208.     IF d.PutStr("\n") = 0 THEN END;
  209.   END;
  210.  
  211.   IF (Argv.globals # d.DOSFALSE) THEN
  212.     dir := "ENV:"; (* space needed for d.AddPart in Examine *)
  213.     Examine(dir,Argv.dir);
  214.   END;
  215.  
  216. CLOSE
  217.   IF Arguments # NIL THEN d.FreeArgs(Arguments) END;
  218.  
  219. END Env.
  220.  
  221.